home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / Balloon.tcl next >
Text File  |  1997-11-22  |  10KB  |  466 lines
  1. # tixBalloon -
  2. #
  3. #    The help widget. It provides both "balloon" type of help message
  4. # and "status bar" type of help message. You can use this widget to indicate
  5. # the function of the widgets inside your application.
  6. #
  7. #
  8. tixWidgetClass tixBalloon {
  9.     -classname TixBalloon
  10.     -superclass tixShell
  11.     -method {
  12.     bind post unbind
  13.     }
  14.     -flag {
  15.     -installcolormap -initwait -state -statusbar
  16.     }
  17.     -configspec {
  18.     {-installcolormap installColormap InstallColormap false}
  19.     {-initwait initWait InitWait 350}
  20.     {-state state State both}
  21.     {-statusbar statusBar StatusBar {}}
  22.  
  23.      {-cursor cursor Cursur left_ptr}
  24.     }
  25.     -default {
  26.     {*background             #ffff60}
  27.     {*foreground             black}
  28.     {*borderWidth             0}
  29.     {.borderWidth             1}
  30.     {.background             black}
  31.     {*Label.anchor            w}
  32.     {*Label.justify            left}
  33.     }
  34. }
  35.  
  36. # Class Record
  37. #
  38. set tixBalloon(bals) {}
  39.  
  40. proc tixBalloon::InitWidgetRec {w} {
  41.     upvar #0 $w data
  42.     global tixBalloon
  43.  
  44.     tixChainMethod $w InitWidgetRec
  45.  
  46.     set data(popped)    0
  47.     set data(client)    {}
  48.  
  49.     lappend tixBalloon(bals) $w
  50. }
  51.  
  52. proc tixBalloon::ConstructWidget {w} {
  53.     upvar #0 $w data
  54.  
  55.     tixChainMethod $w ConstructWidget
  56.  
  57.     wm overrideredirect $w 1
  58.     wm withdraw $w
  59.  
  60.     # Frame 1 : arrow
  61.     frame $w.f1 -bd 0
  62.     set data(w:label) [label $w.f1.lab -bd 0 -relief flat \
  63.                -bitmap [tix getbitmap balArrow]]
  64.     pack $data(w:label) -side left -padx 1 -pady 1
  65.     
  66.     # Frame 2 : Message
  67.     frame $w.f2 -bd 0
  68.     set data(w:message) [label $w.f2.message -padx 0 -pady 0 -bd 0]
  69.     pack $data(w:message) -side left -expand yes -fill both -padx 10 -pady 1
  70.  
  71.     # Pack all
  72.     pack $w.f1 -fill both
  73.     pack $w.f2 -fill both    
  74.  
  75.     # This is an event tag used by the clients
  76.     #
  77.     bind TixBal$w <Destroy> "tixBalloon::ClientDestroy $w %W"
  78. }
  79.  
  80. proc tixBalloon::Destructor {w} {
  81.     global tixBalloon
  82.  
  83.     set bals {}
  84.     foreach b $tixBalloon(bals) {
  85.     if {$w != $b} {
  86.         lappend bals $b
  87.     }
  88.     }
  89.     set tixBalloon(bals) $bals
  90. }
  91.  
  92. #----------------------------------------------------------------------
  93. # Config:
  94. #----------------------------------------------------------------------
  95. proc tixBalloon::config-state {w value} {
  96.     upvar #0 $w data
  97.  
  98.     case $value {
  99.     {none balloon status both} {}
  100.     default {
  101.        error "invalid value $value, must be none, balloon, status, or both"
  102.     }
  103.     }
  104. }
  105.  
  106. #----------------------------------------------------------------------
  107. # "RAW" event bindings:
  108. #----------------------------------------------------------------------
  109.  
  110. bind all <Motion>         "+tixBalloon:XXMotion %X %Y"
  111. bind all <Leave>              "+tixBalloon:XXMotion %X %Y"
  112. bind all <Button>              "+tixBalloon:XXButton   %X %Y %b"
  113. bind all <ButtonRelease>    "+tixBalloon:XXButtonUp %X %Y %b"
  114.  
  115. proc tixBalloon:XXMotion {rootX rootY} {
  116.     global tixBalloon
  117.  
  118.     foreach w $tixBalloon(bals) {
  119.     tixBalloon::XXMotion $w $rootX $rootY
  120.     }
  121. }
  122.  
  123. proc tixBalloon:XXButton {rootX rootY b} {
  124.     global tixBalloon
  125.  
  126.     foreach w $tixBalloon(bals) {
  127.     tixBalloon::XXButton $w $rootX $rootY $b
  128.     }
  129. }
  130.  
  131. proc tixBalloon:XXButtonUp {rootX rootY b} {
  132.     global tixBalloon
  133.  
  134.     foreach w $tixBalloon(bals) {
  135.     tixBalloon::XXButtonUp $w $rootX $rootY $b
  136.     }
  137. }
  138.  
  139. proc tixBalloon::XXMotion {w rootX rootY} {
  140.     upvar #0 $w data
  141.  
  142.     if {$data(-state) == "none"} {
  143.     return
  144.     }
  145.  
  146.     if {[array names data b:*] != {}} {
  147.     # Some buttons are down. Do nothing
  148.     #
  149.     return
  150.     }
  151.  
  152.     if {[grab current $w] != {}} {
  153.     # Someone has grabbed the window
  154.     #
  155.     return
  156.     }
  157.  
  158.     set cw [winfo containing $rootX $rootY]
  159.  
  160.     # Find the a client window that matches
  161.     #
  162.     if {$w == $cw || [string match $w.* $cw]} {
  163.     # Cursor moved over the balloon -- Ignore
  164.     return
  165.     }
  166.  
  167.     while {$cw != {}} {
  168.     if [info exists data(m:$cw)] {
  169.         set client $cw
  170.         break
  171.     } else {
  172.         set cw [winfo parent $cw]
  173.     }
  174.     }
  175.     if {![info exists client]} {
  176.     # The cursor is at a position covered by a non-client
  177.     # Popdown the balloon if it is up
  178.     if {$data(popped)} {
  179.         tixBalloon::Deactivate $w
  180.     }
  181.     set data(client) {}
  182.     catch {
  183.         unset data(cancel) 
  184.     }
  185.     return
  186.     }
  187.  
  188.     if {$data(client) != $client} {
  189.     if {$data(popped)} {
  190.         tixBalloon::Deactivate $w
  191.     }
  192.     set data(client) $client
  193.     after $data(-initwait) tixBalloon::SwitchToClient $w $client
  194.     }
  195. }
  196.  
  197. proc tixBalloon::XXButton {w rootX rootY b} {
  198.     upvar #0 $w data
  199.  
  200.     tixBalloon::XXMotion $w $rootX $rootY
  201.  
  202.     set data(b:$b) 1
  203.  
  204.     if {[grab current $w] != {}} {
  205.     # Someone has grabbed the window
  206.     #
  207.     return
  208.     }
  209.  
  210.     if {$data(popped)} {
  211.     tixBalloon::Deactivate $w
  212.     } else {
  213.     set data(cancel) 1
  214.     }
  215. }
  216.  
  217. proc tixBalloon::XXButtonUp {w rootX rootY b} {
  218.     upvar #0 $w data
  219.  
  220.     tixBalloon::XXMotion $w $rootX $rootY
  221.     catch {
  222.     unset data(b:$b)
  223.     }
  224. }
  225.  
  226. #----------------------------------------------------------------------
  227. # "COOKED" event bindings:
  228. #----------------------------------------------------------------------
  229.  
  230. # switch the balloon to a new client
  231. #
  232. proc tixBalloon::SwitchToClient {w client} {
  233.     upvar #0 $w data
  234.  
  235.     if {![winfo exists $w]} {
  236.     return
  237.     }
  238.     if {![winfo exists $client]} {
  239.     return
  240.     }
  241.     if {$client != $data(client)} {
  242.     return
  243.     }
  244.     if [info exists data(cancel)] {
  245.     catch {
  246.         unset data(cancel)
  247.     }
  248.     return
  249.     }
  250.  
  251.     if {[grab current $w] != {}} {
  252.     # Someone has grabbed the window
  253.     #
  254.     return
  255.     }
  256.  
  257.     tixBalloon::Activate $w
  258. }
  259.  
  260. proc tixBalloon::ClientDestroy {w client} {
  261.     if {![winfo exists $w]} {
  262.     return
  263.     }
  264.  
  265.     upvar #0 $w data
  266.  
  267.     if {$data(client) == $client} {
  268.     tixBalloon::Deactivate $w
  269.     set data(client) {}
  270.     }
  271.  
  272.     # Maybe thses have already been unset by the Destroy method
  273.     #
  274.     catch {unset data(m:$client)}
  275.     catch {unset data(s:$client)}
  276. }
  277.  
  278. #----------------------------------------------------------------------
  279. # Popping up balloon:
  280. #----------------------------------------------------------------------
  281. proc tixBalloon::Activate {w} {
  282.     upvar #0 $w data
  283.  
  284.     switch $data(-state) {
  285.     "both" {
  286.         tixBalloon::PopUp $w
  287.         tixBalloon::SetStatus $w
  288.     }
  289.     "balloon" {
  290.         tixBalloon::PopUp $w
  291.     }
  292.     "status" {
  293.         tixBalloon::SetStatus $w
  294.     }
  295.     }
  296.  
  297.     set data(popped) 1
  298.  
  299.     after 200 tixBalloon::Verify $w
  300. }
  301.  
  302. proc tixBalloon::Verify {w} {
  303.     upvar #0 $w data
  304.  
  305.     if {![winfo exists $w]} {
  306.     return
  307.     }
  308.     if {!$data(popped)} {
  309.     return
  310.     }
  311.     if {[grab current $w] != {}} {
  312.     # Someone has grabbed the window
  313.     #
  314.     tixBalloon::Deactivate $w
  315.     return
  316.     }
  317.     after 200 tixBalloon::Verify $w
  318. }
  319.  
  320. proc tixBalloon::Deactivate {w} {
  321.     upvar #0 $w data
  322.  
  323.     tixBalloon::PopDown $w
  324.     tixBalloon::ClearStatus $w
  325.     set data(popped) 0
  326.     catch {
  327.     unset data(cancel)
  328.     }
  329. }
  330.  
  331. proc tixBalloon::PopUp {w} {
  332.     upvar #0 $w data
  333.  
  334.     if [tixGetBoolean -nocomplain $data(-installcolormap)] {
  335.     wm colormapwindows [winfo toplevel $data(client)] $w
  336.     }
  337.  
  338.     # trick: the following lines allow the balloon window to
  339.     # acquire a stable width and height when it is finally
  340.     # put on the visible screen
  341.     #
  342.     set client $data(client)
  343.     $data(w:message) config -text $data(m:$client)
  344.     wm geometry $w +10000+10000
  345.     wm deiconify $w
  346.     raise $w
  347.     update
  348.  
  349.     # The windows may become destroyed as a result of the "update" command
  350.     #
  351.     if {![winfo exists $w]} {
  352.     return
  353.     }
  354.     if {![winfo exists $client]} {
  355.     return
  356.     }
  357.     # Put it on the visible screen
  358.     #
  359.     set x [expr [winfo rootx $client]+[winfo width  $client]/2]
  360.     set y [expr int([winfo rooty $client]+[winfo height $client]/1.3)]
  361.  
  362.     wm geometry $w +$x+$y
  363. }
  364.  
  365. proc tixBalloon::PopDown {w} {
  366.     upvar #0 $w data
  367.  
  368.     # Close the balloon
  369.     #
  370.     wm withdraw $w
  371.  
  372.     # We don't set the data(client) to be zero, so that the balloon
  373.     # will re-appear only if you move out then in the client window
  374.     # set data(client) {}
  375. }
  376.  
  377. proc tixBalloon::SetStatus {w} {
  378.     upvar #0 $w data
  379.  
  380.     if {![winfo exists $data(-statusbar)]} {
  381.     return
  382.     }
  383.  
  384.     set vv [$data(-statusbar) cget -textvariable]
  385.     if {$vv == ""} {
  386.     $data(-statusbar) config -text $data(s:$data(client))
  387.     } else {
  388.     uplevel #0 set $vv [list $data(s:$data(client))]
  389.     }
  390. }
  391.  
  392. proc tixBalloon::ClearStatus {w} {
  393.     upvar #0 $w data
  394.  
  395.     if {![winfo exists $data(-statusbar)]} {
  396.     return
  397.     }
  398.  
  399.     # Clear the StatusBar widget
  400.     #
  401.     set vv [$data(-statusbar) cget -textvariable]
  402.     if {$vv == ""} {
  403.     $data(-statusbar) config -text ""
  404.     } else {
  405.     uplevel #0 set $vv [list ""]
  406.     }
  407. }
  408.  
  409. #----------------------------------------------------------------------
  410. # PublicMethods:
  411. #----------------------------------------------------------------------
  412.  
  413. # %% if balloon is already popped-up for this client, change mesage
  414. #
  415. proc tixBalloon::bind {w client args} {
  416.     upvar #0 $w data
  417.  
  418.     if [info exists data(m:$client)] {
  419.     set alreadyBound 1
  420.     } else {
  421.     set alreadyBound 0
  422.     }
  423.  
  424.     set opt(-balloonmsg) {}
  425.     set opt(-statusmsg)  {}
  426.     set opt(-msg)        {}
  427.  
  428.     tixHandleOptions opt {-balloonmsg -msg -statusmsg} $args
  429.  
  430.     if {$opt(-balloonmsg) != {}} {
  431.     set data(m:$client) $opt(-balloonmsg)
  432.     } else {
  433.     set data(m:$client) $opt(-msg)
  434.     }
  435.     if {$opt(-statusmsg) != {}} {
  436.     set data(s:$client) $opt(-statusmsg)
  437.     } else {
  438.     set data(s:$client) $opt(-msg)
  439.     }
  440.  
  441.     tixAppendBindTag $client TixBal$w
  442. }
  443.  
  444. proc tixBalloon::post {w client} {
  445.     upvar #0 $w data
  446.  
  447.     if {![info exists data(m:$client)]} {
  448.     return
  449.     }
  450.     tixBalloon::Enter $w $client
  451.     incr data(fakeEnter)
  452. }
  453.  
  454. proc tixBalloon::unbind {w client} {
  455.     upvar #0 $w data
  456.  
  457.     if [info exists data(m:$client)] {
  458.     catch {unset data(m:$client)}
  459.     catch {unset data(s:$client)}
  460.  
  461.     if [winfo exists $client] {
  462.         catch {tixDeleteBindTag $client TixBal$w}
  463.     }
  464.     }
  465. }
  466.